;;; idrop-core.el --- Drop-down menu interface - Core functions

;;; TODO: insert file and package descripion, history, commentary and license.

()

;;; x) useful macros

(eval-when-compile (require 'cl)) ;; a lot of cl functions used, i think

(eval-when-compile (font-lock-add-keywords
   'emacs-lisp-mode
   '(("(\\(idrop-defcustom\\|idrop-defface\\|idrop-defvar\\)\\>" 1 font-lock-keyword-face))))

(defvar idrop-shadow-symbol-names nil
  "A list of names of symbols (variables or faces) prefixed with
\"idrop--\" and having similarly named user-customizable
counterparts.

These are the actual variables used within idrop code. They exist
because the normal \"let\" way of shadowing variables woulnd't
work if the intent was, for example, to have an idrop-list
temporarily painted red.

This is because of the way idrop works internally: Using
`pre-command-hook' and `post-command-hook' every redisplay of the
idrop happens in after a distinct interactive \"idropish\"
command is trigerred by the user.")

(defmacro idrop-define (thing symbol value doc &rest args)
  "Same as `defvar', `defcustom' or `defface' (according to
  THING), but defines asomen additional variable, using `defvar'
  prefixed with \"idrop--\" instead of \"idrop\""
  (let* ((symbol-name (symbol-name symbol))
         (shadow-sym-name (when (string-match "^idrop-" symbol-name)
                              (replace-regexp-in-string "^idrop-" "idrop--" (symbol-name symbol)))))
    (when shadow-sym-name
      (unintern shadow-sym-name)
      (add-to-list 'idrop-shadow-symbol-names shadow-sym-name)
      (cond ((memq thing '(var custom))
             `(progn
                (defvar ,(intern shadow-sym-name)
                  ,value
                  ,(concat doc
                           (format "\n\nThis is an internal shadow variable created with `idrop-define'.")
                           (if (eq thing 'var)
                               (format "\nBetter left alone. Use %s instead." symbol)
                             (format "\nTo customize use `%s' instead!" symbol))))
                ,(cond ((eq thing 'var)
                        `(defvar ,symbol ,value ,doc))
                       ((eq thing 'custom)
                        `(defcustom ,symbol ,value ,doc ,@args)))))
            ((eq thing 'face)
             `(progn
                (defface ,symbol ,value ,doc ,@args)
                ;; (defface ,(intern shadow-sym-name)
;;                   ,value
;;                   ,(concat doc
;;                            (format "\n\nThis is an internal shadow face created with `idrop-define'.")
;;                            (format "\nTo customize use `%s' instead!" symbol))
;;                   ,@args)
))))))

(defmacro idrop-defvar (symbol spec doc &rest args)
  (declare (indent 1) (debug t))
  "Same as `defvar', but defines an additional variable, using
`defvar' prefixed with \"idrop--\" instead of \"idrop-\""
  `(idrop-define var ,symbol ,spec ,doc ,@args))

(defmacro idrop-defcustom (symbol spec doc &rest args)
  (declare (indent 1) (debug t))
  "Same as `defcustom', but defines an additional variable, using
`defvar' prefixed with \"idrop--\" instead of \"idrop-\""
  `(idrop-define custom ,symbol ,spec ,doc ,@args))

(defmacro idrop-defface (symbol spec doc &rest args)
  (declare (indent 1) (debug t))
  "Same as `defface', but defines an additional variable, using
`defvar' prefixed with \"idrop--\" instead of \"idrop-\""
  `(defface ,symbol ,spec ,doc ,@args))

;;; x) user customizable faces

(idrop-defface idrop
  '((t (:inherit default
                 :background "peach puff")))
  "Face used in the idrop. This mostly defines the idrop
background, and is used by other faces who inherit from it."
  :group 'idrop)

(idrop-defface idrop-submenu-selection
  '((t (:inherit idrop-submenu
                 :weight bold
                 :underline t)))
  "Face used for a submenu idrop candidate that is currently
  selected."
  :group 'idrop)

(idrop-defface idrop-simple-selection
  '((t (:inherit idrop-candidate
                 :underline t)))
  "Face used for a normal idrop candidate that is currently
  selected."
  :group 'idrop)

(idrop-defface idrop-indicator
  '((t (:inherit idrop
                 :foreground "OrangeRed")))
  "Face used for the idrop numbered indicators"
  :group 'idrop)

(idrop-defface idrop-indicator-mouse-highlight
  '((t (:inherit idrop-indicator
                 :underline t)))
  "Face used for the idrop numbered indicators, on mouse-over."
  :group 'idrop)

(idrop-defface idrop-extra-indicator
  '((t (:inherit idrop-candidate
                 :foreground "tomato")))
  "Face used for the idrop candidate's extra indicators.

Might be overriden by the extra indicator's own text properties
if they are non-NIL."
  :group 'idrop)

(idrop-defface idrop-text
  '((t (:inherit idrop
                 :weight bold
                 :underline t)))
  "Face used for the user-entered text in the idrop."
  :group 'idrop)

(idrop-defface idrop-submenu
  '((t (:inherit idrop-indicator)))
  "Face used for an idrop candidate that is a submenu or has subcandidates."
  :group 'idrop)

(idrop-defface idrop-candidate
  '((t (:inherit idrop
                 :background "gray")))
  "Face used for a normal idrop candidate."
  :group 'idrop)

(idrop-defface idrop-simple-mouse-highlight
  '((t (:inherit idrop-selection
                 :underline t)))
  "Face used for a normal idrop candidate, on mouse over."
  :group 'idrop)

(idrop-defface idrop-submenu-mouse-highlight
  '((t (:inherit idrop-submenu-selection)))
  "Face used for a submenu idrop candidate on mouse-over."
  :group 'idrop)

(idrop-defface idrop-disabled
  '((t (:inherit idrop-candidate
                 :underline t
                 :foreground "Gray")))
  "Face used for idrop candidates which are either unselectable or
unconfirmable."
  :group 'idrop-candidate)

(idrop-defface idrop-title
  '((t (:inherit idrop-indicator
                 :inverse-video t)))
  "Face used for the idrop title."
  :group 'idrop)

;;; x) user customizable variables

(idrop-defcustom idrop-can-scroll-indicator-text "<more>"
  "Indicator string used if scrolling is possible."
    ;;FIXME: update `idrop-can-scroll-up-indicator' and `down'
    ;;constants when this option is set.
  :type '(string)
  :group 'idrop)

(idrop-defcustom idrop-back-indicator-text "<back>"
  "Indicator string used if going back to a previous idrop is
possible."
  ;;FIXME: update `idrop-back-indicator' constant when this option is set.
  :type '(string)
  :group 'idrop)

(idrop-defcustom idrop-no-match-indicator "<no match>"
  "Indicator string used no matches exist."
  :type '(string)
  :group 'idrop)

(idrop-defcustom idrop-ellipsis-indicator "..."
  "Substitute string if the text of the idrop is too long.

This string should preferably be quite short in width, as it
itself takes up space in the dropdown. Unspecified behaviour when
the width of `idrop-ellipsis-indicator' exceeds or nears
`idrop-nominal-line-width'."
  :type '(string)
  :group 'idrop)

(idrop-defcustom idrop-can-scroll-around nil
  "If non-NIL scroll around is possible in the idrop list."
  :type '(boolean)
  :group 'idrop)

(idrop-defcustom idrop-nominal-dimensions (cons 25 6)
  "Maximum width and height in colums/lines of the \"shortened\"
version of the idrop.

The width excludes the digit indicators. TODO: fix this
inconsistent behaviour

If any idrop candidate and its extra indicators exceeds the
specified width width, it will be truncated using
`idrop-ellipsis-indicator'.

If any idrop candidates are scrolled out, a line containing
`idrop-can-scroll-indicator-text' is added.
1
The maximum dimensions of the idrop can then be switched to
`idrop-max-dimensions' which tries to display candidates
untruncated and minimize the number of scrolled out candidates."
  :type '(cons)
  :group 'idrop)

(idrop-defcustom idrop-max-dimensions (cons 60 12)
  "Maximum width and height in colums/lines of the \"lengthened\"
version of the idrop.

See the description of `idrop-nominal-dimensions'"
  :type '(cons)
  :group 'idrop)

(idrop-defcustom idrop-indicator-width 3
  "Width in columns for a idrop number indicator."
  :type '(integer)
  :group 'idrop)

(idrop-defcustom idrop-vary-width (list 'onfiltering)
  "Non-nil means the idrop can stretch or collapse in width to
  accomodate longer or smaller candidates.


Value is a list of symbols. The following symbols are possible as
elements of a list:

`onfiltering'  vary width when refiltering

`onscrolling'  vary width when rescrolling

Otherwise, the idrop keeps its width, except when explicitly
commanded to redimension"
  :type '(list)
  :group 'idrop)

(idrop-defcustom idrop-use-side-indicators t
  "Non-nil means display numbered indicator shortcuts besides
  each candidate."
  :type '(boolean)
  :group 'idrop)

(idrop-defcustom idrop-merge-subcandidates (list 'ontab 'filter)
  "Controls showing nested subcandidates in the idrop.

Value is a list of symbols. The following symbols are possible as
elements of a list:

`filter' Show subcandidates when filtering is applied.

`ontab'  Eventually show subcandidates if `idrop-magic-tab' is
         invoked a sufficient number of times.

`always' Always show subcandidates.

Subcandidates are only expanded up to
`idrop-merge-subcandidates-max-depth' levels"
  ;; TODO: get the widget type in here
  :type '(list)
  :group 'idrop)

(idrop-defcustom idrop-merge-subcandidates-max-depth 3
  "Maximum depth to considered when merging subcandidates."
  :type '(integer)
  :group 'idrop)

(idrop-defcustom idrop-merge-keep-parent-candidate 'maybe
  "Decide if the parent menu should be shown when merging
  subcandidates.

The following value are possible:

`never' Hide the parent even if some of its subcandidates appear.

`always' Show the parent even if none of its subcandidates
         appear.

`maybe'    Show the parent only if some of its subcandidates
           appear.

All other values mean keep the parent candidate if its name
matches the search."
  :type '(choice (const :tag "Depends, maybe"  maybe)
                 (const :tag "Always"          always)
                 (const :tag "Never"           never))
  :group 'idrop)

(idrop-defcustom idrop-scroll-context-lines 2
  "Number of candidates to keep after each `idrop-scroll-up' or
  `idrop-scroll-down' command"
  :type 'integer
  :group 'idrop)

(idrop-defcustom idrop-display-center-p 'center
  "Indicates if the idrop should be displayed centered in the
screen.

The following value are possible:

`center' Vertically and horizontally center the idrop on screen

`down'   Vertically, drop the idrop down the current screen
         line. Horizontally, start at the next column

`up'     Vertically, opposite of `down'. Horizontally, the same.

`wobble' Vertically try to center the idrop on the currently
         selected candidate. Horizontally the same as `down' and `up'."
  :type '(choice (cons :tag "Center" center)
                 (cons :tag "Down" down)
                 (cons :tag "Up" up)
                 (cons :tag "Wobble" wobble))
  :group 'idrop)

;;; x) keymap variables

(idrop-defvar idrop-common-keymap (make-sparse-keymap)
  "Keymap used while navigating the idrop list")

(fset 'idrop-control-keymap idrop--common-keymap)

(defun idrop-setup-keymaps ()
  ;; TODO: take the hardcoded shit from here
  ;; idrop-control-keymap
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "C-p")      'idrop-previous-candidate)
    (define-key map (kbd "C-r")      'idrop-previous-candidate)
    (define-key map (kbd "C-n")      'idrop-next-candidate)
    (define-key map (kbd "C-s")      'idrop-next-candidate)

    (define-key map (kbd "C-v")      'idrop-scroll-up)
    (define-key map (kbd "M-v")      'idrop-scroll-down)

    (define-key map (kbd "M->")      'idrop-scroll-to-bottom)
    (define-key map (kbd "M-<")      'idrop-scroll-to-top)

    (define-key map (kbd "C-l")      'idrop-scroll-center-on-candidate)

    (define-key map (kbd "M-p")      'idrop-previous-history-element)
    (define-key map (kbd "M-n")      'idrop-next-history-element)

    (define-key map (kbd "RET")      'idrop-confirm)
    (define-key map (kbd "<backspace>") 'idrop-magic-backspace)
    (define-key map (kbd "DEL")      'idrop-magic-backspace)
    (define-key map (kbd "C-g")      'idrop-quit)

    (define-key map (kbd "<space>")  'idrop-magic-tab)
    (define-key map "\t"             'idrop-magic-tab)
    (define-key map (kbd "<backtab>") 'idrop-magic-backtab)
    (define-key map (kbd "S-<tab>") 'idrop-magic-backtab)

    (define-key map [down-mouse-1]   'idrop-do-nothing)
    (define-key map [double-mouse-1] 'idrop-do-nothing)
    (define-key map [triple-mouse-1] 'idrop-do-nothing)

    ;; (define-key map (kbd "C-t")      'idrop-dump-candidate)
    (define-key map (kbd "C-t")      'idrop-debug-some-vars)

    (define-key map `[,mouse-wheel-up-event]   'idrop-wheel-scroll-up)
    (define-key map `[,mouse-wheel-down-event] 'idrop-wheel-scroll-down)

    (do* ((char (make-vector 1 ?0) (prog1 char (aset char 0 (1+ (aref char 0))))))
        ((> (aref char 0) ?9))
      (define-key map  char 'idrop-digit-shortcut))

    ;; text input stuff stuff
    (define-key map [remap self-insert-command] 'idrop-self-insert-command)
    (define-key map [remap backward-kill-word]   'idrop-backward-kill-word)
    ;; unfortunate;y
    (define-key map [remap aquamacs-backward-kill-word]   'idrop-backward-kill-word)

    (setq idrop-common-keymap map)))

(eval-when-compile
  (idrop-setup-keymaps))

;;; x) types `idrop', `idrop-candidate' "intimate" accessors.

(defstruct (idrop (:constructor idrop-make-idrop))
  "TODO: Describe this structure"
  ;; the candidates the idrop was originally built from
  candidates
  ;; the currently showing list of filtered candidates, might include
  ;; subcandidates
  filtered
  ;; a sublist the `filtered' list, containing candidates that are to
  ;; be numbered
  numbered
  ;; the index of the `filtered' list indicating the currently
  ;; selected candidate
  (selidx nil)
  ;; the current width in columns of the idrop
  width
  ;; number of currently visible candidates
  nvisible
  ;; numbered of currently scrolled out candidates, i.e. above the
  ;; first visible candidate
  (scrolled-out 0)
  ;; a string containing the title of the idrop
  title
  ;; a keymap used to extrand `idrop-common-keymap'
  keymap
  ;; a pointer (possibly nil) to the idrop of which the current idrop
  ;; is a submenu
  previous
  ;; in case `previous' is non-nil the depth of the current submenu
  ;; idrop
  (depth 0)
  ;; flag indicating if this idrop is currently hiding candidates
  hiding-candidates
  ;; flag indicating if this idrop is currently truncating candidates
  (truncating-candidates nil)
  ;; ;; flag indicating if this idrop is currently merging all its subcandidates
  ;; (expanding-all-subcandidates nil)
  ;; A function to call back in case the user confirmed the idrop
  ;; choice with actually no candidate selected.
  fallback-callback
  ;; A hash table of cached searched for this idrop
  ;;
  (cached-searches (make-hash-table :test #'equal)))

(defun idrop-enlarged-p (dd)
  "Return t if DD is \"enlarged\" to `idrop-max-dimensions'"
  (and (eq idrop-current-max-line-width (car idrop-max-dimensions))
       (eq idrop-current-max-height (cdr idrop-max-dimensions))))

(defun idrop-hiding-candidates-p (dd)
  (idrop-hiding-candidates dd))

(defun idrop-delete-candidate (dd candidate)
  (setf (idrop-candidates dd)
        (delete sel (idrop-candidates dd))))

(defun idrop-can-complete-user-input-p (dd)
  ;; TODO: add preficate for tab completion
  nil)

(defstruct (idrop-candidate (:constructor idrop-make-candidate))
  "Defines candidate object to be displayed in the idrop list.

TODO: review this

NAME is a string, symbol or an expression returning string. The
resulting string will still be propertized with property `face'
and value `idrop-candidate' or `idrop-selection' depending on
whether the candidate is selected or not.

CALLBACK is a function to be called without args or an expression
to be evaluated.

SELECTABLE is a boolean expression indicating if the item can be
selected.

CONFIRMABLE is a boolean expression indicating if the item can be
confirmed.

EXTRA-INDICATOR is a string or an expression, that should return
a small string. The string will still be propertized with
property `face' and value `idrop-indicator'

HELP is a string or expression that should return a string. The
string is displayed in the echo area when the candidate is
selected.

SUBCANDIDATES is...

DEPTH and EXPANDING are internal properties and should not be
initialized by clients construction of an idrop-candidate

TODO: make a decent, safe constructor for idrop-candidate that
prohibits initialization of internal properties.
"
  name
  callback
  (selectable t)
  (confirmable t)
  hidden
  extra-indicator
  help
  subcandidates
  (depth 0)
  (expanding nil))

(defun idrop-candidate-call-callback (candidate)
  "Executes whichever command is defined for CANDIDATE.

  In case CANDIDATE is a submenu and no `:callback' property is
  defined, this function automatically calls `idrop-internal' on
  the subcandidates"
  (let ((callback-prop (idrop-candidate-callback candidate)))
    ;; (message "tracing callback-prop: %s" callback-prop)
    (cond ((null callback-prop)
           (if (idrop-candidate-submenu-p candidate)
               (idrop-internal (idrop-candidate-subcandidates candidate)
                               :title (idrop-candidate-string candidate)
                               ;; XXX: 1+ relative candidate depth is
                               ;; passed as the `subidrop' parameter
                               :subidrop-depth (1+ (idrop-relative-candidate-depth (idrop-active) candidate))
                               :no-vars-reload t)
             (idrop-candidate-string candidate)))
          ((and (consp callback-prop)
                (not (eq 'lambda (car callback-prop))))
           (eval callback-prop))
          (t
           (if (commandp callback-prop)
               (call-interactively callback-prop)
             (funcall callback-prop))))))

(defun idrop-candidate-selectable-p (candidate)
  "Returns non-Nil if CANDIDATE is selectable in the idrop."
  (let ((selectable-prop (idrop-candidate-selectable candidate)))
    (and selectable-prop
         (eval selectable-prop))))

(defun idrop-candidate-confirmable-p (candidate)
  "Returns non-Nil if CANDIDATE is confirmable in the idrop,
i.e. if the corresponding callback is enabled."
  (let ((confirmable-prop (idrop-candidate-confirmable candidate)))
    (or confirmable-prop
        (eval confirmable-prop))))

(defun idrop-candidate-hidden-p (candidate)
  "Returns non-Nil if CANDIDATE is hidden in the idrop,
i.e. if it is NOT displayed when `idrop-hiding-candidates-p' for
the idrop is non-Nil."
  (let ((hidden-prop (idrop-candidate-hidden candidate)))
    (or (not (null hidden-prop))
        (eval hidden-prop))))

(defun idrop-candidate-full-width (candidate)
  ;;FIXME: This horrible function repeats logic in
  ;;`idrop-candidate-simple-format'. To refactor.

  "Returns the full width in columns of CANDIDATE, adding the
  `string-width' of its formatted string, the possible
  subcandidate indent, and the length of any extra-indicators.
"
  (let* ((normal-width (string-width (idrop-candidate-string candidate)))
         (extra-indicator (idrop-candidate-make-extra-indicator candidate))
         (extra-width (when extra-indicator (string-width extra-indicator)))
         (extra-extra-width (* (idrop-relative-candidate-depth (idrop-active) candidate) (string-width idrop-depth-indent-string))))
    (apply #'+ (remove nil (list normal-width extra-width extra-extra-width)))))

(defun idrop-candidate-string (candidate)
  "Returns the full name of CANDIDATE, from its `:name-prop'
expression"
  (let ((name-prop (idrop-candidate-name candidate)))
    (cond ((stringp name-prop)
           name-prop)
          ((symbolp name-prop)
           (symbol-name name-prop))
          (t
           (eval name-prop)))))

(defun idrop-candidate-make-extra-indicator (candidate)
  "Returns the extra-indicators of CANDIDATE, from its
`:extra-indicator' property"
  (let ((extra-indicator-prop (idrop-candidate-extra-indicator candidate)))
    (when extra-indicator-prop
      (if (stringp extra-indicator-prop)
          extra-indicator-prop
        (eval extra-indicator-prop)))))

(defun idrop-relative-candidate-depth (dd candidate)
  ;; FIXME: replace with a suitable accessor for the `depth' field of
  ;; the `idrop-candidate' structure.
  "Return the depth of CANDIDATE relative to the IDROP.

This can differ from `idrop-candidate-depth' when IDROP is itself
a subidrop"
  (- (idrop-candidate-depth candidate)
     (idrop-depth dd)))

(defun idrop-candidate-submenu-p (candidate)
  "Return t when CANDIDATE is a submenu."
  (when (idrop-candidate-subcandidates candidate) t))

(defun idrop-candidate-manual-contracting-p (candidate)
  "Return non-Nil only when CANDIDATE was manually set to \"contract\"."
  (eq (idrop-candidate-expanding candidate) 'idrop-manual-contract))

(defun idrop-candidate-expanding-p (candidate &optional manualp)
  "Return non-nil when CANDIDATE is expanding its
subcandidates. If MANUALP is non-Nil return non-Nil only if the
candidate was expanded manually"
  (let ((prop-value (idrop-candidate-expanding candidate)))
    (cond (manualp
           (eq prop-value 'idrop-manual-expand))
          ((or (eq prop-value 'idrop-manual-expand)
               (and prop-value
                    (not (eq prop-value 'idrop-manual-contract))))))))

(defun idrop-candidate-simple-format (dd candidate)
  "Format CANDIDATE for IDROP.

The functions name contains the word \"simple\" because maybe in
future extensions more complex functions can be added"
  (let* ((submenu-p (idrop-candidate-subcandidates candidate))
         (available-width (- (idrop-width dd) (idrop-relative-candidate-depth dd candidate)))
         (extra-indicator (idrop-candidate-make-extra-indicator candidate))
         (not-indented-string (idrop-format-line (idrop-candidate-string candidate)
                                                 (- available-width idrop-indicator-width)
                                                 (cond (submenu-p
                                                        'idrop-submenu)
                                                       ((not (and (idrop-candidate-confirmable-p candidate)
                                                                  (idrop-candidate-selectable-p candidate)))
                                                        'idrop-disabled)
                                                       (t
                                                        'idrop-candidate))
                                                 extra-indicator
                                                 32
                                                 'idrop-extra-indicator)))
    (concat (propertize (apply #'concat (make-list (idrop-relative-candidate-depth dd candidate) idrop-depth-indent-string))
                        'face 'idrop-candidate)
            (idrop-format-line
             (if (idrop-candidate-selectable-p candidate)
                 (propertize not-indented-string
                             'mouse-face (if submenu-p
                                             'idrop-submenu-mouse-highlight
                                           'idrop-simple-mouse-highlight)
                             'idrop-candidate candidate
                             'keymap idrop-candidate-keymap)
               not-indented-string)
             available-width
             (when (eq candidate (idrop-selected dd))
               (if submenu-p
                   'idrop-submenu-selection
                 'idrop-simple-selection))
             (idrop-make-side-indicator dd candidate submenu-p)
             32))))

;; FIXME: disable down-mouse-1, double-clicks and triple clicks in these keymaps

(defconst idrop-candidate-keymap
  (let ((map (make-sparse-keymap)))
    (define-key map [mouse-1] `idrop-click-on-candidate)
    (set-keymap-parent map 'idrop-control-keymap)
    map)
  "Keymap used for propertizing in the candidate text")

(defconst idrop-side-indicator-keymap
  (let ((map (make-sparse-keymap)))
    (define-key map [mouse-1] 'idrop-click-toggle-expand)
    (set-keymap-parent map 'idrop-control-keymap)
    map)
  "Keymap used for propertizing the side indicators")

(defconst idrop-can-scroll-up-indicator
  (propertize idrop-can-scroll-indicator-text
              'mouse-face 'idrop-indicator-mouse-highlight
              'keymap (let ((map (make-sparse-keymap)))
                        (define-key map [mouse-1] 'idrop-scroll-up)
                        (set-keymap-parent map 'idrop-control-keymap)
                        map))
  "Indicator used for scrolling up")

(defconst idrop-can-scroll-down-indicator
  (propertize idrop-can-scroll-indicator-text
              'mouse-face 'idrop-indicator-mouse-highlight
              'keymap (let ((map (make-sparse-keymap)))
                        (define-key map [mouse-1] 'idrop-scroll-down)
                        (set-keymap-parent map 'idrop-control-keymap)
                        map))
  "Indicator used for scrolling down")

(defconst idrop-back-indicator
  (propertize idrop-back-indicator-text
              'mouse-face 'idrop-indicator-mouse-highlight
              'keymap (let ((map (make-sparse-keymap)))
                           (define-key map [mouse-1] 'idrop-back)
                           (set-keymap-parent map 'idrop-control-keymap)
                           map))
  "Indicator used for going back in the chain of idrops")

(defun idrop-make-side-indicator (dd candidate &optional submenu-p)
  "Makes an indicator for CANDIDATE, member of the candidates in
IDROP."
  (let ((position (and idrop-use-side-indicators
                       (position candidate (idrop-numbered dd)))))
    (concat (if submenu-p
                (propertize (if (idrop-candidate-expanding-p candidate) "v" ">")
                            'mouse-face 'idrop-indicator-mouse-highlight
                            'keymap     idrop-side-indicator-keymap)
              " ")
            (make-string (- idrop-indicator-width 2) 32)
            (if (and position
                     (< position 9))
                (format "%d" (1+ position))
              " "))))

;;; x) search structure

(defstruct (idrop-search (:constructor idrop-make-search))
  text
  filter-fn
  to-filter
  filtered
  pending-subsearches
  owner
  start-time)

(defun idrop-flatten-search (ss)
  (let (flattened
        (to-filter (idrop-search-to-filter ss)))
    (while to-filter
      (push (car-to-filter flattened))
      (when (idrop-search-p (car to-filter))
        (setq flattened (nconc flattened
                               (idrop-flatten-search (car-to-filter)))))
      (setq to-filter (cdr to-filter)))
    flattened))

;;; x) misc internal variables
;;;
;;; TODO: some of these have to be user variables

(defvar idrop-control-overlay nil
  "Overlay used to associate `idrop-control-keymap' to.")

(idrop-defvar idrop-filter-function #'idrop-filter-substring
  "Function used to filter candidates")

(idrop-defvar idrop-text nil
  "Holds the input text of the user")

(idrop-defvar idrop-keep-previous-idrop nil
  ;; TODO: implement `idrop-keep-previous-idrop'
  "Non-nil means the previous idrop should keep showing if
  possible, even when a sub-idrop is shown")

(idrop-defvar idrop-after-init-hook nil
  "Hooks run once before displaying each idrop.

After basic initialization in `idrop-internal' and before first
displaying the idrop. Its counterpart is the `idrop-cleanup-hook'.")

(idrop-defvar idrop-display-before-hook nil
  "Hook run before recalculating and redisplaying the idrop")

(idrop-defvar idrop-display-refilter-hook nil
  "Hook run after recalculating the idrop's candidate list")

(idrop-defvar idrop-display-restretch-hook nil
  "Hook run after restretching the idrop")

(idrop-defvar idrop-display-rescroll-hook nil
  "Hook run after recalculating the scrolling of the idrop")

(idrop-defvar idrop-cleanup-hook nil
  "Hook run after cleaning up each idrop.

This happens on explicit idrop quit, confirmation of a candidate,
or executing some other non-idropish command.

Functions in this hook are called while the idrop internal
variables (like `idrop-active') are still bound. In particular,
this hook is called before a callback to a candidate is
effectively executed.

Its counterpart is the `idrop-after-init-hook' ")

(idrop-defvar idrop-exit-hook nil
  "Hook run after definitely exiting the idrop.

This hook is run as often as the `idrop-cleanup-hook', but after
every cleanup is made. ")

(defvar idrop-current-max-line-width (car idrop-nominal-dimensions)
  "Holds the current maximum width in columns of the idrop. The
  user can invoke `idrop-toggle-max-width' to toggle this between
  the values set in `idrop-nominal-width' and `idrop-max-width'.")

(defvar idrop-current-max-height (cdr idrop-nominal-dimensions)
  "Holds the current maximum height in screen-lines of the
  idrop. The user can invoke `idrop-toggle-max-height' to toggle
  this between the values set in `idrop-nominal-height' and
  `idrop-max-height'.")

(defvar idrop-display-method-fn nil
  "Specifies what display method the idrop should use.

The value is a function receiving two arguments: an `idrop'
structure and a formatted idrop (see `idrop-display-format').

The following functions can be used

`idrop-display-overlays'    Use text overlays
`idrop-display-frame'       Use a special popup frame

Don't change this function directly, customize
`idrop-display-method' instead.")

(defvar idrop-display-calculate-size-fn nil
  "Specifies the available horizontal and vertical dimensions for
the idrop.

The value is a function receiving the idrop as an argument. The
function should return a cons cell (XMAX, YMAX) specifying
maximum dimensions.

Don't change this function directly, customize
`idrop-display-method' instead.")

(idrop-defvar idrop-depth-indent-string " "
  "String used when indenting subcandidates in the idrop.

This string is repeated `idrop-relative-candidate-depth' times.")

(defvar idrop-recalculate-items nil
  "A list of symbols representing pending internal formatting actions to the idrop list.

The list is processed by the function `idrop-recalculate-maybe'. Each element can be:

`restretch'
`refilter'
`rescroll'")

;;; x) positioning functions

(defun idrop-calculate-width (dd)
  "Calculates the width for idrop DD. This is fairly inneficient
and is probably stored in DD's `idrop-width' field."
  ;; FIXME: Inneficient way to calculate this
  ;; TODO: new idrop-filtered structure
  (let* ((filtered (and dd (idrop-filtered dd))))
    (min idrop-current-max-line-width
         (+ idrop-indicator-width
            (apply #'max (remove nil
                                 (append
                                  (list (string-width (idrop-title dd)))
                                  (mapcar #'(lambda (c)
                                              (idrop-candidate-full-width c))
                                          filtered))))))))

;;; x) string construction funtions

(defun idrop-format-line (text width face &optional indicator fill indicator-face)
  "Formats TEXT, applying FACE and optionally adding INDICATOR,
to the width of DD and using FILL as padding.

The length of the string output will be WIDTH +
`idrop-indicator-width'"
  (let* ((real-width (if indicator
                         (- width (string-width indicator))
                       width))
         ( ;; remove newlines
          text
          (replace-regexp-in-string "\n" "\\\\n" text)))

    (when (> (string-width text) real-width)
      (setq indicator (concat idrop-ellipsis-indicator indicator))
      (setq real-width (- width (string-width indicator)))
      ;; FIXME: kind of a hack to access `idrop-active' in this
      ;; like this.
      (when (idrop-active) (setf (idrop-truncating-candidates (idrop-active)) t)))
    (concat (if face
                (propertize (truncate-string-to-width text real-width nil (or fill ? )) 'face face)
              (truncate-string-to-width text real-width nil (or fill ? )))
            (and indicator (propertize indicator 'face (or indicator-face
                                                           'idrop-indicator))))))

;;; x) idrop-filtering and related functions

(defun idrop-filter-substring (text cand)
  (or (not text)
      (condition-case oops
          (string-match text (idrop-candidate-name cand))
        (error (message "Temporarily invalid regexp!")
               t))))

;;; x) recalculation and scroll-related functions

(defun idrop-restretch (dd)
  "Recalculates the dimensions (heigth and width) of the idrop DD.

Should be called after `idrop-refilter'"
  (setf (idrop-width dd) (idrop-calculate-width dd))
  (setf (idrop-nvisible dd) (or (and idrop-current-max-height
                                     (min (idrop-nfiltered dd)
                                          idrop-current-max-height)))))

(defun idrop-rescroll (dd &optional ignore-selection)
  "Recalculates the scrolling of the idrop DD.

Sets `idrop-scrolled-out' field based on `idrop-nvisible',
`idrop-nfiltered' and `idrop-selidx' fields of DD. Should be
called after `idrop-restrech'"
  ;; Unselect any selected candidates if necessary, then force
  ;; rescrolling.
  (when (and (not ignore-selection)
             (idrop-selidx dd)
             (or (< (idrop-selidx dd) (idrop-scrolled-out dd))
                 (>= (idrop-selidx dd) (+ (idrop-scrolled-out dd)
                                          (idrop-nvisible dd)))))
    (setf (idrop-selidx dd) nil))
  (cond ( ;; Don't scroll anywhere
         (not (idrop-selidx dd)))
        ( ;; Scroll down
         (>= (idrop-selidx dd) (+ (idrop-nvisible dd)
                                  (idrop-scrolled-out dd)))
         (cond ( ;; Scroll down normally, increase `scrolled-out'
                (< (idrop-selidx dd)
                   (idrop-nfiltered dd))
                (incf (idrop-scrolled-out dd)))
               ( ;; Scroll around to beginning of list
                idrop--can-scroll-around
                (setf (idrop-selidx dd) 0)
                (setf (idrop-scrolled-out dd) 0))
               ( ;; Undo the increase in `selidx'
                t
                (decf (idrop-selidx dd)))))
        ( ;; Scroll up
         (< (idrop-selidx dd) (idrop-scrolled-out dd))
         (cond ( ;; Scroll up normally, decrease `scrolled-out'
                (> (idrop-scrolled-out dd) 0)
                (decf (idrop-scrolled-out dd)))
               ( ;; Scroll around to end of list
                idrop--can-scroll-around
                (setf (idrop-selidx dd) (1- (idrop-nfiltered dd)))
                (setf (idrop-scrolled-out dd) (- (idrop-nfiltered dd) (idrop-nvisible dd))))
               (t
                ;; Undo the decrease of `selidx'
                (incf (idrop-selidx dd)))))))

;;; x) interactive commands for idrop control

(defun idrop-do-nothing ()
  ;; Used for binding the mouse-1 event to, which should do nothing i
  ;; think
  (interactive)
  nil)

(defun idrop-dump-candidate ()
  (interactive)
  (let ((candidate (or ;; (idrop-get-candidate-from-event event)
                       (idrop-selected (idrop-active)))))
    (when candidate (idrop-trace candidate))))

(defun idrop-previous-candidate (&optional dd amount)
  "Choose the previous idrop item from DD, with optional
AMOUNT, go up by that amount. May scroll the idrop list."
  (interactive)
  ;; FIXME: horrible HACKS here
  ;; FIXME: if one presses up and no selection, this actually goes
  ;;        down to the first candidate. Should go nowhere or to
  ;;        bottom of list, depending on `idrop--can-scroll-around'
  (let ((dd (or dd
                (idrop-active))))
    (unless (idrop-selidx dd) (setf (idrop-selidx dd) (1- (idrop-scrolled-out dd))))

    ;; TODO: stop refusing to learn `loop'
    ;; FIXME: direct call to `idrop-rescroll' should be avoided
    (decf (idrop-selidx dd) (or amount 1))
    (idrop-rescroll dd 'ignore-selection)
    (while (not (idrop-selected dd))
      (decf (idrop-selidx dd) (or amount 1))
      (idrop-rescroll dd 'ignore-selection))))

(defun idrop-next-candidate (&optional dd amount)
  "Choose the next idrop item from DD, with optional AMOUNT,
go down by that amount. May scroll the idrop list."
  (interactive)
  (idrop-previous-candidate dd (- (or amount 1))))

(defun idrop-magic-backspace (&optional dd)
  "Go back in the chain of idrop lists, if applicable"
  (interactive)
  (let* ((dd (or dd
                (idrop-active)))
         (selected (idrop-selected dd)))
    (cond (;; delete the last character
           (idrop-text)
            (idrop-backward-delete-char))
          (;; go back in the idrop chain
           t
           (idrop-back dd)))))

(defun idrop-magic-backtab (&optional dd)
  "Undo the previous `idrop-magic-tab' command, if more or less
applicable"
  (interactive)
  (let* ((dd (or dd
                 (idrop-active)))
         (selected (idrop-selected dd)))
    (cond (;; contract a possibly expanding candidate
           (and selected
                (idrop-candidate-submenu-p selected)
                (idrop-candidate-expanding-p selected))
           (idrop-candidate-expand-contract 'contract dd selected)))))

(defun idrop-back (&optional dd)
  (interactive)
  (let ((dd (or dd
                (idrop-active))))
        (cond ( ;; go back in the chain of idrops
               (idrop-previous dd)
               (push 'restretch idrop-recalculate-items)
               (setq idrop-active (idrop-previous dd)))
              ( ;; quit
               t
               (idrop-quit dd)))))

(defun idrop-quit (&optional dd)
  "Quit all the idrop lists"
  (interactive)
  (let ((dd (or dd
                (idrop-active))))
    (idrop-cleanup dd)
    (setq idrop-active nil)
    (run-hooks 'idrop--exit-hook)))

(defun idrop-confirm (&optional candidate dont-fallback)
  "Confirm the current idrop list choice"
  (interactive)
  (let* ((dd (idrop-active))
         (sel (or candidate
                  (idrop-selected dd))))
    (cond ((and sel
                (idrop-candidate-confirmable-p sel))
           ;;
           ;; Setup the call to the candidate, then call it.
           ;; `last-command-event' is set to the string because
           ;; apparently that's how the yank menu work anyhow.
           ;;
           (setq last-command-event (idrop-candidate-string sel))
           (idrop-cleanup dd)
           (idrop-candidate-call-callback sel)
           (run-hooks 'idrop--exit-hook))
          (;;
           ;; Use a fallback callback (user confirmed with no
           ;; candidate selected) if it exists and `dont-fallback' is
           ;; false. Big exception is the call to `idrop-quit' here!
           ;;
           (and (not dont-fallback)
                (idrop-fallback-callback dd))
           (funcall (idrop-fallback-callback dd))
           (idrop-quit))
          (;;
           ;; Complain with message.
           ;;
           (unless (idrop-fallback-callback dd)
             (message "Invalid choice!")
             (ding))))))

(defun idrop-digit-shortcut (&optional dd)
  (interactive)
  (let* ((dd (or dd
                 (idrop-active)))
         (n (- last-command-char ?0 1))
         (candidate (and (>= n 0)
                         (nth n (idrop-numbered dd)))))
    (cond (candidate
           (idrop-confirm candidate 'dont-fallback))
          (t
           (list 'idrop-error "Invalid digit selection")))))

(defun idrop-magic-tab (&optional dd)
  (interactive)
  (let* ((dd (or dd
                 (idrop-active)))
         (selected (idrop-selected dd)))
    (cond ((and selected
                (idrop-candidate-submenu-p selected)
                (not (idrop-candidate-expanding-p selected)))
           (idrop-candidate-expand-contract 'expand dd selected))
          ((and selected
                (not (idrop-candidate-centered-p dd selected)))
           (idrop-scroll-center-on-candidate dd selected))
          (t
           (cond (;; (1) check if anything can be completed, if so
                  ;; complete
                  (idrop-can-complete-user-input-p dd)
                  (idrop-complete-user-input dd))
                 ( ;; (2) check if anything would be gained from enlarging
                  ;; then enlarge horizontally and vertically.c
                  (and (or (< (idrop-nvisible dd) (idrop-nfiltered dd))
                           (idrop-truncating-candidates dd))
                       (not (idrop-enlarged-p dd)))
                  (idrop-enlarge dd))
                 ;; ( ;; (3) check if merging is possible, if so merge
                 ;;  ;; subcandidates
                 ;;  (and (memq 'ontab idrop-merge-subcandidates)
                 ;;       (not (idrop-expanding-all-subcandidates dd)))
                 ;;  (setf (idrop-expanding-all-subcandidates dd) t)
                 ;;  (setf idrop-recalculate-items (nconc idrop-recalculate-items '(restretch refilter))))
                 ( ;; (4) check if any candidates are hidden, then reveal
                  ;; them
                  (idrop-hiding-candidates-p dd)
                  (idrop-reveal-hidden-candidates dd))
                 ( ;; (5) just scroll up, but only if no candidate is selected.
                  (not selected)
                  (idrop-scroll-up)))))))

(defun idrop-complete-user-input (&optional dd)
  "Complete whatever can be completed in the user's input to the
  idrop"
  (interactive)
  (let ((dd (or dd
                (idrop-active)))
        (message "TODO: add prefix, suffix, whateverix completion")
        (ding))))

(defun idrop-enlarge (&optional dd shrinkinstead)
  "Confirm the current idrop list choice"
  (interactive)
  (let ((dd (or dd
                (idrop-active))))
    (cond ((not shrinkinstead)
           (setq idrop-current-max-line-width (car idrop-max-dimensions))
           (setq idrop-current-max-height (cdr idrop-max-dimensions)))
          (t
           (setq idrop-current-max-line-width (car idrop-nominal-dimensions))
           (setq idrop-current-max-height (cdr idrop-nominal-dimensions))))
    (push 'restretch idrop-recalculate-items)))

(defun idrop-reveal-hidden-candidates (&optional dd)
  (interactive)
  (let ((dd (or dd
                (idrop-active))))
    (setf (idrop-hiding-candidates dd) nil)
    (push 'refilter idrop-recalculate-items)))

(defun idrop-scroll-up (&optional dd amount scroll-down)
  (interactive)
  (let* ((dd (or dd
                 (idrop-active)))
         (amount (or amount
                     (- (idrop-nvisible dd)
                        (or (and idrop-scroll-context-lines
                                 (min idrop-scroll-context-lines
                                      (- (idrop-nvisible dd) 1)))
                            0)))))
    (cond (scroll-down
           (cond ((> (idrop-scrolled-out dd) amount)
                  (decf (idrop-scrolled-out dd) amount))
                 ((= (idrop-scrolled-out dd) 0)
                  (when idrop--can-scroll-around (idrop-scroll-to-bottom)))
                 (t
                  (idrop-scroll-to-top))))
          (t
           (cond ((< amount (- (idrop-nfiltered dd)
                               (idrop-scrolled-out dd)
                               (idrop-nvisible dd)))
                  (incf (idrop-scrolled-out dd) amount))
                 ((= (idrop-nfiltered dd) (+ (idrop-scrolled-out dd)
                                             (idrop-nvisible dd)))
                  (when idrop--scroll-around (idrop-scroll-to-top)))
                 (t
                  (idrop-scroll-to-bottom dd)))))
    (push 'rescroll idrop-recalculate-items)))

(defun idrop-candidate-centered-p (dd candidate)
  ;; TODO: new idrop-filtered structure
  (or (= (idrop-scrolled-out dd) (position candidate (idrop-filtered dd)))
      (= (idrop-scrolled-out dd) (- (idrop-nfiltered dd) (idrop-nvisible dd)))))

(defun idrop-scroll-center-on-candidate (&optional dd candidate)
  ;; TODO: new idrop-filtered structure
  (interactive)
  (let* ((dd (or dd
                 (idrop-active)))
         (candidate (or candidate
                        (idrop-selected dd))))
    (setf (idrop-scrolled-out dd)
          (min
           (position candidate (idrop-filtered dd))
           (- (idrop-nfiltered dd) (idrop-nvisible dd))))
    (push 'rescroll idrop-recalculate-items)))

(defun idrop-scroll-down (&optional dd amount)
  (interactive)
  (idrop-scroll-up dd amount 'scroll-down))

(defun idrop-wheel-scroll-up (&optional dd)
  (interactive)
  (let ((idrop--can-scroll-around nil))
    (idrop-scroll-up dd 2 nil)))

(defun idrop-wheel-scroll-down (&optional dd)
  (interactive)
  (let ((idrop--can-scroll-around nil))
    (idrop-scroll-up dd 2 'scroll-down)))

(defun idrop-scroll-to-bottom (&optional dd)
  (interactive)
  (let ((dd (or dd
                 (idrop-active))))
    (setf (idrop-scrolled-out dd) (- (idrop-nfiltered dd)
                                     (idrop-nvisible dd)))
    (setf (idrop-selidx dd) (1- (idrop-nfiltered dd))))
  (push 'rescroll idrop-recalculate-items))

(defun idrop-scroll-to-top (&optional dd)
  (interactive)
  (let ((dd (or dd
                (idrop-active))))
    (setf (idrop-scrolled-out dd) 0)
    (setf (idrop-selidx dd) 0))
  (push 'rescroll idrop-recalculate-items))

(defun idrop-candidate-expand-contract (&optional action dd candidate)
  (interactive)
  (let* ((action (or action
                     'toggle))
         (dd (or dd
                 (idrop-active)))
         (candidate (or candidate
                        (idrop-selected dd))))
    (cond ((eq action 'toggle)
           (cond ((idrop-candidate-expanding-p candidate)
                  (setf (idrop-candidate-expanding candidate) 'idrop-manual-contract))
                 (t
                  (setf (idrop-candidate-expanding candidate) 'idrop-manual-expand))))
          ((eq action 'expand)
           (setf (idrop-candidate-expanding candidate) 'idrop-manual-expand))
          ((eq action 'contract)
           (setf (idrop-candidate-expanding candidate) 'idrop-manual-contract))
          (t
           nil))
    (idrop-scroll-center-on-candidate dd candidate) ;; FIXME: isn't working for some reason.
    (setq idrop-recalculate-items (nconc idrop-recalculate-items '(rescroll restretch refilter)))))

;;; x) mouse interactive functions

(defun idrop-get-candidate-from-event (event)
  (let ((obj (car (fifth (second event))))
        (i 0)
        cand)
    (when (stringp obj)
      (while (and i
                  (null (setq cand (get-text-property i 'idrop-candidate obj))))
        (setq i (next-property-change i obj))))
    cand))

(defun idrop-click-on-candidate (&optional event)
  (interactive "e")
  (let ((dd (idrop-active))
        (candidate (idrop-get-candidate-from-event event)))
    (when candidate
      (idrop-confirm candidate))))

(defun idrop-click-toggle-expand (&optional event)
  (interactive "e")
  (let ((dd (idrop-active))
        (candidate (idrop-get-candidate-from-event event)))
    (when candidate
      (idrop-candidate-expand-contract 'toggle dd candidate))))

;;; x) core functions

(defvar idrop-active nil
  "Holds the currently active idrop list")

(defun idrop-active ()
  "Returns the currently active idrop"
  idrop-active)

(defun idrop-cleanup (&optional dd)
  "Remove all traces idrop DD or the currently active idrop."
  (let* ((dd (or dd
                 (idrop-active)))
         (control-overlay idrop-control-overlay))
    ;;
    ;; delete control overlay
    ;;
    (when control-overlay (delete-overlay control-overlay))
    ;;
    ;; remove the idrop from `pre-command-hook'
    ;;
    (remove-hook 'pre-command-hook   'idrop-check-status 'local)
    (remove-hook 'post-command-hook  'idrop-display      'local)
    ;;
    ;; run any method-specific hooks
    ;;
    (run-hooks 'idrop--cleanup-hook)
    ;;
    ;; set `idrop-active' to nil
    ;;
    (setq idrop-active nil)))

(defun idrop-init (dd subidrop)
  "Initialize important internal idrop variables for idrop DD.

When SUBIDROP is non-nil consider that DD is a subidrop. This is
called by `idrop-internal' which itself has the SUBIDROP
parameter"

  (cond (;; initilization of a subidrop, inherits depth and keymap
         (and (idrop-active)
              subidrop)
         (setf (idrop-previous dd) (idrop-active))
         (setf (idrop-depth dd) (+ (idrop-depth (idrop-active))
                                   subidrop))
         (unless (idrop-keymap dd)
           (setf (idrop-keymap dd) (idrop-keymap (idrop-active)))))
        (;; root idrop
         t
         (setq idrop-current-max-line-width (car idrop-nominal-dimensions))
         (setq idrop-current-max-height (cdr idrop-nominal-dimensions))))
  ;; common to either root or subidrops
  (setq idrop-recalculate-items (list 'refilter 'rescroll 'restretch))
  (setq idrop-text nil)
  (setq idrop-active dd))

(defun idrop-selected (dd &optional selidx)
  "Return the currently selected idrop filtered candidate for DD,
if any. SELIDX, when non-nil specifies a an alternate selection
index instead of `idrop-selidx'"
  (let* ((selidx (or selidx
                     (idrop-selidx dd)))
         (possible (and selidx
                        ;; TODO: new idrop-filtered structure
                        (nth selidx (idrop-filtered dd)))))
    (when (and possible
               (idrop-candidate-selectable-p possible))
      possible)))

(defun idrop-nfiltered (dd)
  "Return the number of filtered candidates for DD."
  (length (idrop-filtered dd)))

(defun idrop-candidate-position (candidate dd)
  ;; TODO: new idrop-filtered structure
  )

(defun idrop-text ()
  "Return the currently input user text to the idrop, or nil if
none or it is an empty string"
  (and (stringp idrop-text)
       (not (string= idrop-text ""))
       idrop-text))

(defun idrop-after-edition-command ()
  (push 'refilter idrop-recalculate-items)
  (when (memq 'onfiltering idrop-vary-width)
    (push 'restretch idrop-recalculate-items)))

(defun idrop-self-insert-command ()
  (interactive)
  (setq idrop-text (concat idrop-text (make-string 1 last-command-char)))
  (idrop-after-edition-command))

(defun idrop-backward-delete-char ()
  (interactive)
  (let ((len (length idrop-text)))
    (if (> len 1)
        (setq idrop-text (substring idrop-text 0 (1- len)))
      (setq idrop-text nil)))
  (idrop-after-edition-command))

(defun idrop-backward-kill-word ()
  (interactive)
  (when idrop-text
    (let ((i (1- (length idrop-text))))
      (while (and (/= i 0)
                  (eq ?w
                      (char-syntax (aref idrop-text i))))
        (setq i (1- i)))
      (if (= i 0)
          (setq idrop-text nil)
        (setq idrop-text (substring idrop-text 0 i)))))
  (idrop-after-edition-command))

(defun idrop-check-status ()
 "Cleanup the idrop if running some non-idrop command, otherwise
do nothing.

Intended to be placed in the `pre-command-hook', this function
checks if `this-command' is an \"idrop\" command. If it isn't,
the idrop is exited by running `idrop-cleanup', otherwise the
`post-command-hook' will take care of redisplaying it."
  (unless (string-match "^idrop-" (symbol-name this-command))
    (message "quitting the idrop from non-idrop command %s" this-command)
    (idrop-cleanup)
    (run-hooks 'idrop--exit-hook)))

(defun idrop-display ()
  "Recalculates and displays the active idrop, according to
`idrop-display-method-fn'.

Run after each command as long as it exists in
`post-command-hook', which happens unless it has removed from
there by `idrop-cleanup', called from `idrop-check-status', which
exists in the `pre-command-hook'."
  (let ((dd (idrop-active)))
    ;;
    ;; run a before hook
    ;;
    (run-hooks 'idrop-display-before-hook)
    ;;
    ;; refilter, restretch and rescroll
    ;;
    (when (memq 'refilter idrop-recalculate-items)
      (idrop-async-filter-candidates dd)
      ;; (run-hooks 'idrop-display-refilter-hook)
      )
    (when (memq 'restretch idrop-recalculate-items)
      (idrop-restretch dd)
      (run-hooks 'idrop-display-restretch-hook))
    (when (memq 'rescroll idrop-recalculate-items)
      (idrop-rescroll dd)
      (run-hooks 'idrop-display-rescroll-hook))
    ;;
    ;; clear some flags
    ;;
    (setq idrop-recalculate-items nil)
    (setf (idrop-truncating-candidates dd) nil)
    (funcall idrop-display-method-fn
             dd
             (when (idrop-text)
               (idrop-format-line idrop-text (idrop-width dd) 'idrop-text))
             (idrop-display-format dd))))

(defun idrop-display-format (dd)
  "Formats the idrop DD's contents for displaying (except for the input text).

Returs a list (LINES OFFSET):

* LINES is a list of strings of the same width, properly
  propertized representing the title, user-input, candidates and
  possible indicators of DD.

* OFFSET is the index of LINES representing the currently
  selected candidate, if any, 0 otherwise"
  ;; TODO: Get rid of this horrible append, and remove and
  ;; remove-if-not.  Myabe make `(idrop-filtered dd)' into an array.
  (let* ((voffset 0)
         (width (idrop-width dd))
         (start-idx (idrop-scrolled-out dd))
         (end-idx (min (+ (idrop-scrolled-out dd) (idrop-nvisible dd))
                       (idrop-nfiltered dd)))
         (flattened (idrop-flatten-search (idrop-filtered dd)))
         (relevant (and flatenned
                        (subseq flatenned start-idx end-idx)))
         candidate
         before
         formatted
         after
         numbered)
    (cond (relevant
           ;;
           ;; for every candidate in `relevant' populate the
           ;; `formatted' and `numbered' lists. Also calculate
           ;; `voffset'
           ;;
           (while relevant
             (setq candidate (car relevant))
             (push (funcall #'idrop-candidate-simple-format dd candidate)
                   formatted)
             (when (>= voffset 0)
               (setq voffset (1+ voffset)))
             (when (eq (idrop-selected dd)
                       candidate)
               (setq voffset (- voffset)))
             (when (idrop-candidate-confirmable-p candidate)
               (push candidate
                     numbered))
             (setq relevant (cdr relevant)))
           ;;
           ;; reverse the lists, since push put them in the wrong
           ;; orders
           ;;
           (setq formatted (nreverse formatted))
           (setq numbered (nreverse numbered)))
          (t
           ;;
           ;; Add a "no match" indicator, only if no search is in
           ;; progress anymore
           ;;
           (unless (idrop-search-in-progress-p (idrop-filtered dd))
             (setq formatted (list (idrop-format-line "" width 'idrop-indicator idrop-no-match-indicator))))))
    ;;
    ;; Add before and after items to the idrop
    ;;
    (when (idrop-search-in-progress-p (idrop-filtered dd))
      (push after (idrop-format-line "Working..." width 'idrop-indicator)))
    (when (< end-idx (idrop-nfiltered dd))
      (push after (idrop-format-line "" width 'idrop-indicator idrop-can-scroll-up-indicator)))

    (when (< 0 (idrop-scrolled-out dd))
      (push before
            (idrop-format-line "" width 'idrop-indicator idrop-can-scroll-down-indicator)))
    (when (idrop-title dd)
      (push before
            (idrop-format-line (idrop-title dd) (idrop-width dd) 'idrop-title (unless (eq 0 (idrop-depth dd))
                                                                                idrop-back-indicator))))
    (setq voffset
          (- voffset (length before)))
    (list (nconc before formatted after)
          (- voffset))))

(defun idrop-save-shadow-vars ()
  "Saves the value of each variable defined with
`idrop-defcustom' into an \"internal shadow variable\".

Such a variable has exactly the same name, but starts with
\"idrop--\", instead of \"idrop-\"."
  (mapc #'(lambda (shadow-name)
              (let ((user-visible-name (replace-regexp-in-string "^idrop--" "idrop-" shadow-name)))
                (if (facep (intern shadow-name))
                    (copy-face (intern user-visible-name) ; old-face
                               (intern shadow-name))      ; 'new-face' just like 'old-face'
                  (eval `(setq ,(intern shadow-name)
                               ',(symbol-value (intern user-visible-name)))))))
          idrop-shadow-symbol-names))

;;; x) asynchronous operation

(defvar idrop-async-resume-timer nil
  "Timer that `idrop-timer-function' used to reschedule itself, or nil.")

(defvar idrop-async-slots (cons 0.100 0.100)

  "Cons cell (GENERATE . BREAK) where GENERATE and BREAK are
values in seconds of the timeslot allocated to candidate
generation and break, respectively.")

(defvar idrop-last-search-start-time nil
  "debug variable")

(defvar idrop-last-generation-start-time nil
  "debug variable")

(defvar idrop-async-breaks-taken 0
  "debug variable")

(defun idrop-async-run (fn-spec &optional defer-first done-fn-specs no-break-count-reset)
  (unless no-break-count-reset
    (setq idrop-async-breaks-taken 0))
  (let ((flag (if defer-first
                  'taking-a-break
                  'continue))
        (start-time (current-time))
        elapsed-time)
    (when idrop-async-resume-timer
      (cancel-timer idrop-async-resume-timer))
    (while (eq flag 'continue)
      (unless (apply (car fn-spec) (cdr fn-spec))
        (setq flag 'exit))
      (cond ((eq flag 'exit)
             (when done-fn-specs
               (mapc #'(lambda (spec)
                         (apply (car spec) (cdr spec)))
                     done-fn-specs)))
            (t
             (setq elapsed-time
                   (time-subtract (current-time) start-time))
             (when (or (input-pending-p)
                       (time-less-p (seconds-to-time (car idrop-async-slots))
                                    elapsed-time))
               (setq flag 'taking-a-break)
               (idrop-trace "taking break")))))
    (when (eq flag 'taking-a-break)
      (setq idrop-async-breaks-taken (1+ idrop-async-breaks-taken))
      (setq idrop-async-resume-timer
            (run-with-idle-timer
             ;; Compute an idle time break-length
             ;; more than the current value.
             (seconds-to-time (cdr idrop-async-slots))
             nil
             'idrop-async-run
             fn-spec
             nil
             done-fn-specs
             t)))))

;;; x) asynchronous operation - candidate generation

(defstruct (idrop-generator (:constructor idrop-make-generator))
  fn-spec
  generated
  start-time)

(defun idrop-async-generate-step (generator)
  (let* ((fn-spec (idrop-generator-fn-spec generator))
         (c (funcall (car fn-spec)
                     (cdr fn-spec)
                     (null (idrop-generator-generated generator)))))
    (cond ((listp c)
           (nconc c (idrop-generator-generated generated)))
          (c
           (push c (idrop-generator-generated generator)))
          (t
           nil))))

(defun idrop-async-store-generated-candidates (gg owner &optional ss)
  ;; FIXME: remove this trace
  ;; (idrop-trace "Generation done in" (time-to-seconds (time-subtract (current-time) (idrop-generator-start-time gg))) "secs with "
  ;;              idrop-async-breaks-taken "breaks")
  ;; (idrop-trace "Generation result is " (mapcar #'idrop-candidate-name (idrop-generator-generated gg)))
  (cond ((idrop-p owner)
         (setf (idrop-candidates owner) (idrop-generator-generated gg)))
        ((idrop-candidate-p owner)
         (setf (idrop-candidate-subcandidates owner) (idrop-generator-generated gg))))
  (when ss
    (setf (idrop-search-to-filter ss) (idrop-generator-generated gg))))

;;; x) asynchronous operation - searching

(defun idrop-async-search-step (dd ss &optional parent-sss)
  ;; (idrop-trace "idrop-async-search-step for" (length parent-sss) "parents")
  (let* ((to-filter (idrop-search-to-filter ss)))
    (cond ((idrop-generator-p to-filter)
           ;;
           ;;
           ;;
           (setf (idrop-generator-start-time to-filter) (current-time))
           (setf (idrop-generator-generated to-filter) nil)
           (idrop-async-run `(idrop-async-generate-step ,to-filter)
                            'defer-first
                            `((idrop-async-store-generated-candidates ,to-filter
                                                                      ,(idrop-search-owner ss)
                                                                      ,ss)
                              (idrop-async-run (,#'idrop-async-search-step ,dd ,ss ,parent-sss)
                                               defer-first)))
           nil)
          (to-filter
           ;;
           ;;
           ;;
           (setf (idrop-search-to-filter ss) (cdr to-filter))
           (let* ((candidate (car to-filter))
                  (subcandidates (idrop-candidate-subcandidates candidate))
                  (subsearch (and subcandidates
                                  (idrop-make-search :text (idrop-search-text ss)
                                                     :filter-fn (idrop-search-filter-fn ss)
                                                     :to-filter subcandidates
                                                     :owner candidate))))
             (cond (subsearch
                    (push subsearch (idrop-search-pending-subsearches ss))
                    (push subsearch (idrop-search-filtered ss)))
                   (t
                    (when (funcall (idrop-search-filter-fn ss)
                                   (idrop-search-text ss)
                                   candidate)
                      (push candidate (idrop-search-filtered ss))))))
           t)
          ((idrop-search-pending-subsearches ss)
           ;;
           ;;
           ;;
           (idrop-async-run `(idrop-async-search-step ,dd
                                                      ,(car (idrop-search-pending-subsearches ss))
                                                      ,(cons ss parent-sss)))
           (setf (idrop-search-pending-subsearches ss)
                 (cdr (idrop-search-pending-subsearches ss)))
           (when (null parent-sss)
             (idrop-async-display-results dd ss))
           nil)
          (parent-sss
           ;;
           ;;
           ;;
           ;; (idrop-trace "rolling back...")
           (idrop-async-search-step dd (car parent-sss) (cdr parent-sss)))
          (t
           ;;
           ;;
           ;;
           (idrop-async-display-results dd ss)
           nil))))

(defun idrop-async-display-results (dd ss)
  ;; FIXME: remove this trace
  ;; (idrop-trace "Search done in" (time-to-seconds (time-subtract (current-time) (idrop-search-start-time ss))) "secs with"
  ;;              idrop-async-breaks-taken "breaks")
  ;; (idrop-trace "Search result is " (idrop-search-print-results ss))
  (unless (equal (idrop-filtered dd)
                 ss)
    (setq idrop-recalculate-items (list 'rescroll 'restretch))
    (setf (idrop-filtered dd) ss)
    ;;(idrop-display)
    ))

(defun idrop-async-refilter (dd)
  (let ((ss (or (gethash (cons (idrop-text) idrop-filter-function)
                         (idrop-cached-searches dd))
                (puthash (cons idrop-text
                               idrop-filter-function)
                         (idrop-make-search :text (idrop-text)
                                            :filter-fn idrop-filter-function
                                            :to-filter (idrop-candidates dd)
                                            :owner dd)
                         (idrop-cached-searches dd)))))
    (setf (idrop-search-start-time ss) (current-time))
    (idrop-async-run `(idrop-async-search-step ,dd ,ss)
                     'defer-first)))

;;; x) main entry point

(defun idrop-internal (candidates &rest args)
  "Creates the idrop instance from CANDIDATES and waits for user
input before doing anything."
  ;;
  ;; save user-visible idropish variables to correspondent shadow
  ;; variables
  ;;
  (unless (getf args :no-vars-reload)
    (idrop-save-shadow-vars))

  (let (command
        ret
        (dd (idrop-make-idrop :candidates            candidates
                              :hiding-candidates     (some #'idrop-candidate-hidden-p candidates)
                              :keymap                (getf args :subkeymap)
                              :title                 (or (getf args :title)
                                                         "choose:")
                              :fallback-callback     (getf args :fallback-callback-fn))))

    (idrop-init dd (getf args :subidrop-depth))
    ;;
    ;; setup a control keymap which is fsetted on the fly to contain
    ;; the idrop's own private keymap. The display methods (frame or
    ;; overlay) are then responsible for putting this keymap in
    ;; practice.
    ;;
    (fset 'idrop-control-keymap (let ((map (idrop-keymap dd)))
                                      (cond (map
                                             (set-keymap-parent map idrop-common-keymap)
                                             map)
                                            (t
                                             idrop-common-keymap))))
    ;;
    ;; setup the `pre' and `post-command-hook'
    ;;
    (add-hook 'pre-command-hook  'idrop-check-status 'append 'local)
    (add-hook 'post-command-hook 'idrop-display      'append 'local)
    ;;
    ;;
    ;;
    (run-hooks 'idrop-after-init-hook)
    ;;
    ;; force invoke `idrop-check-status', since for this command the
    ;; `pre-command-hook' will not be run.
    ;;
    ;; (idrop-check-status)
))

;;; x) minor mode setup

(defvar idrop-minor-mode-map-entry nil)

(defvar idrop-mode nil)

(defun idrop-mode (&optional arg)
  "Toggle idrop speed-ups on or off.
With ARG, turn idrop speed-up on if arg is positive, off otherwise.
Turning on idrop-mode will remap (via a minor-mode keymap) the default
keybindings for the `find-file' and `switch-to-buffer' families of
commands to the idrop versions of these functions.
However, if ARG arg equals 'files, remap only commands for files, or
if it equals 'buffers, remap only commands for buffer switching.
This function also adds a hook to the minibuffer."
  (interactive "P")
  (setq idrop-mode
        (cond
         ((null arg) (if idrop-mode nil 'both))
         ((eq arg t) 'both)
         ((eq arg 'files) 'file)
         ((eq arg 'buffers) 'buffer)
         ((memq arg '(file buffer both)) arg)
         ((> (prefix-numeric-value arg) 0) 'both)
         (t nil)))

  ;; (idrop-everywhere (if idrop-everywhere 1 -1))
  ;; (when idrop-mode
  ;;   (idrop-init-completion-maps))

  (cond (idrop-mode
         ;; (add-hook 'minibuffer-setup-hook 'idrop-minibuffer-setup)
         ;; (add-hook 'choose-completion-string-functions 'idrop-choose-completion-string)
         ;; (idrop-load-history)

         ;; (add-hook 'kill-emacs-hook 'idrop-kill-emacs-hook)

         (let ((map (make-sparse-keymap)))

           (define-key map (kbd "C-c d") 'idrop-popup-main-menu)
           (define-key map (kbd "C-c /") 'idrop-hippie-expand)

           (when (memq idrop-mode '(file both))
             ;; (define-key map [remap find-file] 'idrop-find-file) XXX: Restore when working
             ;; (define-key map [remap find-file-read-only] 'idrop-find-file-read-only)
             ;; (define-key map [remap find-alternate-file] 'idrop-find-alternate-file)
             ;; (define-key map [remap write-file] 'idrop-write-file)
             ;; (define-key map [remap insert-file] 'idrop-insert-file)
             ;; (define-key map [remap list-directory] 'idrop-list-directory)
             ;; (define-key map [remap dired] 'idrop-dired)
             ;; (define-key map [remap find-file-other-window] 'idrop-find-file-other-window)
             ;; (define-key map [remap find-file-read-only-other-window] 'idrop-find-file-read-only-other-window)
             ;; (define-key map [remap find-file-other-frame] 'idrop-find-file-other-frame)
             ;; (define-key map [remap find-file-read-only-other-frame] 'idrop-find-file-read-only-other-frame)
             )

           (when (memq idrop-mode '(buffer both))
             (define-key map [remap switch-to-buffer] 'idrop-switch-buffer)
             (define-key map [remap switch-to-buffer-other-window] 'idrop-switch-buffer-other-window)
             (define-key map [remap switch-to-buffer-other-frame] 'idrop-switch-buffer-other-frame)
             (define-key map [remap insert-buffer] 'idrop-insert-buffer)
             (define-key map [remap kill-buffer] 'idrop-kill-buffer)
             (define-key map [remap display-buffer] 'idrop-display-buffer))

           (if idrop-minor-mode-map-entry
               (setcdr idrop-minor-mode-map-entry map)
             (setq idrop-minor-mode-map-entry (cons 'idrop-mode map))
             (add-to-list 'minor-mode-map-alist idrop-minor-mode-map-entry))
           (message "idrop-mode enabled.")))
        (t
         (message "idrop-mode disabled."))))

(defun idrop-exterminate ()
  (interactive)
  (idrop-mode -1)
  (mapatoms #'(lambda (atom)
                (when (string-match "idrop" (symbol-name atom))
                  (unintern atom)))))

;;; x) tracing functions

(defvar idrop-trace-on nil)

(defun idrop-toggle-trace ()
  (interactive)
  (setq idrop-trace-on (not idrop-trace-on))
  (message "Idrop trace is %s !" (if idrop-trace-on "ON" "OFF")))

(defun idrop-trace (&rest objects)
  (when idrop-trace-on
    (save-window-excursion
      (let* ((buffer (get-buffer-create "*idrop-trace*"))
             (standard-output buffer))
      (pop-to-buffer buffer )
      (while objects
        (if (and (symbolp (car objects))
                 (boundp (car objects)))
            (princ (symbol-value (car objects)))
          (princ (car objects)))
        (princ " ")
        (setq objects (cdr objects)))
      (princ "\n")))))

(defun idrop-search-print-results (ss)
  (mapconcat #'(lambda (corss)
                 (if (idrop-search-p corss)
                     (concat "$SS:owner="
                             (if (idrop-candidate-p (idrop-search-owner corss))
                                 (idrop-candidate-name (idrop-search-owner corss))
                               "DD")
                             " ("
                             (idrop-search-print-results corss)
                             ")")
                   (idrop-candidate-name corss)))
             (idrop-search-filtered ss)
             " "))

(defmacro idrop-mapv (fn array)
  "Map FN to every element of ARRAY"
  (declare (indent 1) (debug t))
  (let ((i (gensym)))
  `(dotimes (,i (length ,array))
     (funcall ,fn (aref ,array ,i)))))

(defmacro idrop-mapv-range (fn array start end)
  "Map FN to elements of ARRAY from START to END."
  (declare (indent 1) (debug t))
  (let ((i (gensym)))
    `(when (and (< ,start ,end)
                (< ,end (length ,array)))
       (dotimes (,i (- ,end ,start))
         (funcall ,fn (aref ,array (+ ,i ,start)))))))

(defmacro idrop-with-buffer-unmodified (&rest body)
  ;; Copied from mumamo, but dangerous, try not to use too much.
  ;; Actually not used in the idrop logic, only in `idrop-hippie-expand'
  "Eval BODY, preserving the current buffer's modified state."
  (declare (indent 0) (debug t))
  (let ((modified (gensym)))
    `(let ((,modified (buffer-modified-p)))
       (unwind-protect
           (progn ,@body)
         (unless ,modified
           (restore-buffer-modified-p nil))))))

(eval-when-compile (font-lock-add-keywords
   'emacs-lisp-mode
   '(("(\\(idrop-with-buffer-unmodified\\)\\>" 1 font-lock-keyword-face))))

(defun idrop-debug-some-vars ()
  "Debug some idrop vars."
  (interactive)
  (with-output-to-temp-buffer "*idrop-trace*"
    (princ "Interesting idrop vars: \n\n")


    (princ (format "Current idrop-depth: %s\n" (idrop-depth (idrop-active))))
    (princ (format "Current calculated candidate depth: %s\n" (when (idrop-selected (idrop-active))
                                                                (idrop-relative-candidate-depth  (idrop-active)
                                                                                                  (idrop-selected (idrop-active))))))
    (princ (format "Current stored candidate depth: %s\n" (when (idrop-selected (idrop-active))
                                                            (idrop-candidate-depth (idrop-selected (idrop-active))))))

    (princ (format "Local map: %s\n" (current-local-map)))

    ;; (princ (format "  screen-line cached %s\n" (get 'idrop-overlays 'screen-line)))
    ;; (princ (format "  missed-lines cached %s\n" (get 'idrop-overlays 'missed-lines)))
    ;; (princ (format "  starting-point-cached %s\n" (get 'idrop-overlays 'starting-point)))

    ;; (princ (format "  current (point-max) %s\n" (point-max)))

    ;; (cond ((eq (count-if-not #'null idrop-overlays) 0)
    ;;        (princ "  \n\nNo overlays\n"))
    ;;       (t
    ;;        (idrop-mapv #'(lambda (quad)
    ;;                     (when quad
    ;;                       (princ (format "%s : %s : priority %s : after-string %s\n"
    ;;                                      (first quad)
    ;;                                      (position quad idrop-overlays)
    ;;                                      (overlay-get (first quad) 'priority)
    ;;                                      (overlay-get (first quad) 'after-string)))))
    ;;                 idrop-overlays)))

    (princ (format "\nPost command hook: %s\n" post-command-hook))
    (princ (format "\nPre  command hook: %s\n" pre-command-hook))))

;;; x) provides

(provide 'idrop-core)